Shareware Grab Bag/Shareware Grab Bag.iso/050/madtrb8.arc/SCREEN.INC

Text File | 1985-02-23 | 20.6 KB | 633 lines

{.L+}

{   SCREEN PROCEDURES  }

{procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);}
{FUNCTION READREAL(X,Y,LENGTH,FRACTION:INTEGER):REAL;}
{FUNCTION READINT(X,Y,LENGTH:INTEGER):INTEGER;}
{FUNCTION READSTRING(X,Y,MAXLENGTH:INTEGER):XXXSTR80;}
{FUNCTION READDATE(X,Y:INTEGER):XXXSTR8;}



{.L-}
{.R-}


procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);

var
   i: Integer;

begin
   GotoXY(UpperLeftX, UpperLeftY);  Write(chr(218));
   for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
   Write(chr(191));
   for i:=UpperLeftY+1 to LowerRightY-1 do
      begin
         GotoXY(UpperLeftX , i);  Write(chr(179));
         GotoXY(LowerRightX, i);  Write(chr(179));
      end;
   GotoXY(UpperLeftX, LowerRightY);
   Write(chr(192));
   for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
      Write(chr(217));
end  { Frame };


{**********************************************************************}


FUNCTION READREAL(X,Y,LENGTH,FRACTION:INTEGER):REAL;

{   READS A REAL NUMBER AT LOCATION X,Y }

VAR
   POSITION : INTEGER;
   SECTION : INTEGER;
   SPACEEND : INTEGER;
   EXIT : BOOLEAN;
   HOLDMAIN : REAL;
   HOLDFRACTION : REAL;
   DIGIT : INTEGER;
   INCHAR : CHAR;
   HOLD: REAL;
   COUNT : INTEGER;


FUNCTION POWER(N:INTEGER):REAL;

{ RASES 10 TO THE  SPECIFIED POWER }

VAR
   HOLD : REAL;
   I : INTEGER;

BEGIN
   HOLD := 1;
   FOR I := 1 TO N DO
      HOLD := HOLD * 10.0;
   POWER := HOLD;
END;


BEGIN
   POSITION := 0;
   IF LENGTH > FRACTION + 1 THEN
      SECTION := 1
   ELSE
      BEGIN
         POSITION := 1;
         SECTION := 3;
      END;
   EXIT := FALSE;
   GOTOXY(X,Y);
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(LIGHTGRAY);
   WRITE(XXXSPACE(LENGTH-(FRACTION+1)),'.',XXXSPACE(FRACTION));
   WHILE NOT EXIT DO
      BEGIN
         GOTOXY((X+POSITION),Y);
         READ(KBD,INCHAR);
         CASE SECTION OF
            1: {SPACES BEFORE}
               BEGIN
                  IF ((INCHAR = ' ') AND (POSITION < (LENGTH-FRACTION)))THEN
                     POSITION := POSITION + 1
                  ELSE
                     IF INCHAR IN ['1'..'9','0'] THEN
                        BEGIN
                           POSITION := POSITION + 1;
                           DIGIT := ORD(INCHAR)-48;
                           HOLDMAIN := DIGIT;
                           SECTION  := 2;
                           WRITE(INCHAR);
                           SPACEEND := POSITION;
                        END
                     ELSE
                        IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
                           IF POSITION > 0 THEN
                              BEGIN
                                 POSITION := POSITION - 1;
                                 GOTOXY((X+POSITION),Y);
                                 WRITE(' ');
                              END
                           ELSE
                              WRITE(CHR(7))
                        ELSE
                           WRITE(CHR(7));
               END;
            2: {MAIN PART}
               BEGIN
                  IF INCHAR IN ['1'..'9','0'] THEN
                     BEGIN {CHARATER IS DIGIT ADD TO MAIN}
                        WRITE(INCHAR);
                        DIGIT := ORD(INCHAR)-48;
                        HOLDMAIN := (HOLDMAIN * 10.0) + DIGIT;
                        POSITION := POSITION + 1;
                        IF POSITION = (LENGTH - (FRACTION+1)) THEN
                           BEGIN {SWITCH TO FRACTION SECTION}
                              POSITION := POSITION + 1;
                              IF FRACTION > 0 THEN
                                 BEGIN
                                    COUNT := 0;
                                    HOLDFRACTION := 0.0;
                                    SECTION := 3;
                                 END
                              ELSE
                                 BEGIN
                                    COUNT := 1;
                                    HOLDFRACTION := 0.0;
                                    SECTION := 4;
                                 END;
                           END;
                     END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN    {DELETE}
                           IF POSITION = SPACEEND THEN
                              BEGIN  {SWITCH BACK UP TO SPACE SECTION}
                                 SECTION := 1;
                                 POSITION := POSITION - 1;
                                 GOTOXY((X+POSITION),Y);
                                 WRITE(' ');
                              END
                           ELSE
                              BEGIN {DELETE A DIGIT}
                                 POSITION := POSITION - 1;
                                 GOTOXY((X+POSITION),Y);
                                 WRITE(' ');
                                 HOLDMAIN := INT(HOLDMAIN/10.0);
                              END;
                        END
                     ELSE
                        IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
                           BEGIN {TOTALLY FINISH NUMBER}
                              EXIT := TRUE;
                              HOLDFRACTION := 0;
                              COUNT := 1;
                           END
                        ELSE
                           IF INCHAR = '.' THEN
                              BEGIN
                                 GOTOXY(X,Y);
                                 WRITE(HOLDMAIN:(LENGTH-FRACTION-1):0);
                                 SECTION := 3;
                                 POSITION := LENGTH-FRACTION;
                                 HOLDFRACTION := 0.0;
                                 COUNT := 0;
                              END
                           ELSE
                              BEGIN    {ERROR}
                                 WRITE(CHR(7));
                              END
               END;
            3: {FRACTION}
               BEGIN
                  IF INCHAR IN ['1'..'9','0'] THEN
                     BEGIN  {ADD TO FRACTION CHECK FOR END OF FRACTION}
                        POSITION := POSITION + 1;
                        WRITE(INCHAR);
                        DIGIT := ORD(INCHAR)-48;
                        HOLDFRACTION := (HOLDFRACTION*10.0) + DIGIT;
                        COUNT := COUNT + 1;
                        IF COUNT = FRACTION THEN
                           BEGIN { SWITCH TO EXIT HOLD SECTION}
                              SECTION := 4;
                           END
                     END
                  ELSE
                     IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
                        BEGIN {DELETE}
                           IF COUNT = 0 THEN
                              BEGIN {SWITCH TO MAIN SECTION }
                                 POSITION := POSITION - 2;
                                 GOTOXY((X+POSITION),Y);
                                 WRITE(' ');
                                 HOLDMAIN := INT(HOLDMAIN/10.0);
                                 SECTION := 2;
                              END
                           ELSE
                              BEGIN
                                 HOLDFRACTION := INT(HOLDFRACTION/10.0);
                                 COUNT := COUNT -1;
                                 POSITION := POSITION -1;
                                 GOTOXY((X+POSITION),Y);
                                 WRITE(' ');
                              END;
                        END
                     ELSE
                        IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
                           BEGIN   {FINISH}
                              EXIT := TRUE;
                              IF COUNT = 0 THEN
                                 BEGIN
                                    COUNT := 1;
                                    HOLDFRACTION := 0.0;
                                 END;
                           END
                        ELSE
                           BEGIN     {ERROR}
                              WRITE(CHR(7));
                           END
               END;
            4: {FINISHED}
                BEGIN
                   IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
                      BEGIN   {DELETE}
                         IF FRACTION = 0 THEN
                            BEGIN
                               SECTION := 2;
                               HOLDMAIN := INT(HOLDMAIN/10.0);
                               POSITION := POSITION - 1;
                               GOTOXY((X+POSITION),Y);
                               WRITE(' ');
                            END
                         ELSE
                            BEGIN
                               SECTION := 3;
                               HOLDFRACTION := INT(HOLDFRACTION/10.0);
                               COUNT := COUNT -1;
                               POSITION := POSITION -1;
                               GOTOXY((X+POSITION),Y);
                               WRITE(' ');
                            END;
                      END
                   ELSE
                      IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
                         BEGIN   { EXIT}
                            EXIT := TRUE;
                            IF COUNT = 0 THEN
                               BEGIN
                                  COUNT := 1;
                                  HOLDFRACTION := 0.0;
                               END;
                         END
                       ELSE
                          BEGIN {ERROR}
                             WRITE(CHR(7));
                          END;
                END;
         END;
      END;
   HOLD := HOLDMAIN + (HOLDFRACTION/POWER(COUNT));
   READREAL := HOLD;
   GOTOXY(X,Y);
   WRITE(HOLD:LENGTH:FRACTION);
   TEXTCOLOR(LIGHTGRAY);
   TEXTBACKGROUND(BLACK);
END;



{***************************************************************************}


FUNCTION READINT(X,Y,LENGTH:INTEGER):INTEGER;

{   READS A INTEGER NUMBER FROM THE SCREEN  }

VAR
   HOLD : REAL;
   POWER : INTEGER;
   DIGIT : INTEGER;
   INCHAR : CHAR;
   EXIT : BOOLEAN;
   POSITION : INTEGER;
   HOLD2 : INTEGER;

BEGIN
   IF LENGTH > 5 THEN
      LENGTH := 5;
   EXIT := FALSE;
   GOTOXY(X,Y);
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(LIGHTGRAY);
   WRITE(XXXSPACE(LENGTH));
   HOLD := 0;
   POWER := 1;
   POSITION := 0;
   WHILE NOT EXIT DO
      BEGIN
         GOTOXY((X+POSITION),Y);
         READ(KBD,INCHAR);
         CASE ORD(INCHAR) OF
            11,13:{RETURN OR LINEFEED}
               IF HOLD > 32767.0 THEN
                  BEGIN
                     WRITE(CHR(7));
                     GOTOXY(X,Y);
                     HOLD :=0;
                     POWER := 1;
                     POSITION := 0;
                     WRITE(XXXSPACE(LENGTH),CHR(7));
                  END
               ELSE
                  EXIT := TRUE;
            7,8:{BACKSPACE OR CNTRL G}
               BEGIN
                  IF POSITION > 0 THEN
                     BEGIN
                        POSITION := POSITION - 1;
                        GOTOXY((X+POSITION),Y);
                        WRITE(' ');
                        HOLD := INT(HOLD/10.0);
                        POWER := POWER DIV 10;
                     END
                  ELSE
                     WRITE(CHR(7));
               END;
            48..57:{NUMBERS}
               IF POSITION < LENGTH THEN
                  IF (HOLD*10+(ORD(INCHAR)-48)) <=32767.0 THEN
                     BEGIN
                        HOLD := HOLD*10+(ORD(INCHAR)-48);
                        WRITE(INCHAR);
                        POSITION := POSITION + 1;
                        POWER := POWER * 10;
                     END
                  ELSE
                     WRITE(CHR(7));
            ELSE
               WRITE(CHR(7));
         END;
      END;
   READINT := TRUNC(HOLD);
   HOLD2 := TRUNC(HOLD);
   GOTOXY(X,Y);
   WRITE(HOLD2:LENGTH);
   TEXTCOLOR(LIGHTGRAY);
   TEXTBACKGROUND(BLACK);
END;


{***************************************************************************}


FUNCTION READSTRING(X,Y,MAXLENGTH:INTEGER):XXXSTR80;

{   READS A STRING OF MAXLENGTH 80 FROM THE TERMINAL  }

VAR
   HOLD : XXXSTR80;
   EXIT : BOOLEAN;
   INCHAR : CHAR;
   COUNT : INTEGER;

BEGIN
   COUNT := 0;
   EXIT := FALSE;
   GOTOXY(X,Y);
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(LIGHTGRAY);
   WRITE(XXXSPACE(MAXLENGTH));
   GOTOXY(X,Y);
   HOLD := '';
   WHILE NOT EXIT DO
      BEGIN
         READ(KBD,INCHAR);
         CASE ORD(INCHAR) OF
            13,10,11,12:
               BEGIN
                  EXIT := TRUE;
               END;
            32..125:
               BEGIN
                  IF COUNT < MAXLENGTH THEN
                     BEGIN
                        HOLD := HOLD + INCHAR;
                        WRITE(INCHAR);
                        COUNT := COUNT + 1;
                     END
                  ELSE
                     WRITE(CHR(7));
               END;
            8,7:
               IF COUNT > 0 THEN
                  BEGIN
                     DELETE(HOLD,COUNT,1);
                     COUNT := COUNT - 1;
                     GOTOXY((X+COUNT),Y);
                     WRITE(' ');
                     GOTOXY((X+COUNT),Y);
                  END
               ELSE
                  WRITE(CHR(7));
            27:
               BEGIN
                  HOLD := '';
                  COUNT := 0;
                  GOTOXY(X,Y);
                  WRITE(XXXSPACE(MAXLENGTH));
                  GOTOXY(X,Y);
               END;
            ELSE
               BEGIN
                  WRITE(CHR(7));
                  GOTOXY(X,Y);
                  WRITE(XXXSPACE(MAXLENGTH));
                  GOTOXY(X,Y);
                  WRITE(HOLD);
                  GOTOXY((X+COUNT),Y);
               END;
         END;
      END;
   READSTRING :=HOLD;
   TEXTCOLOR(LIGHTGRAY);
   TEXTBACKGROUND(BLACK);
END;


{***************************************************************************}


FUNCTION READDATE(X,Y:INTEGER):XXXSTR8;

{  READS A STRING FROM THE TERMINAL FROM SCREEN AT POSITION XY  }
{    THE STRING WILL CONTAIN A VALID DATE IN FORMAT 00/00/00  }

VAR
   HOLD : ARRAY [1..6] OF CHAR;
   LOCATION : INTEGER;
   INCHAR : CHAR;

BEGIN
   LOCATION := 1;
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(LIGHTGRAY);
   GOTOXY(X,Y);
   WRITE('  /  /  ');
   GOTOXY(X,Y);
   WHILE LOCATION<8 DO
      BEGIN
         READ(KBD,INCHAR);
         CASE LOCATION OF
            1:
               BEGIN
                  GOTOXY(X,Y);
                  IF INCHAR IN ['1','0',' '] THEN
                     BEGIN
                        HOLD[1] := INCHAR;
                        WRITE(INCHAR);
                        LOCATION := 2;
                        GOTOXY((X+1),Y);
                     END
                  ELSE
                     BEGIN
                        WRITE(CHR(7));
                     END;
               END;
            2:
               BEGIN
                  GOTOXY((X+1),Y);
                  IF INCHAR IN ['1'..'9','0'] THEN
                     IF HOLD[1]='1' THEN
                        IF INCHAR IN ['1','2','0'] THEN
                           BEGIN
                              HOLD[2] := INCHAR;
                              WRITE(INCHAR);
                              LOCATION := 3;
                           END
                        ELSE
                           BEGIN
                              WRITE(CHR(7));
                           END
                     ELSE
                        BEGIN
                           WRITE(INCHAR);
                           HOLD[2] := INCHAR;
                           LOCATION := 3;
                        END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN
                           GOTOXY(X,Y);
                           WRITE(' ');
                           LOCATION := 1;
                           HOLD[1] := ' ';
                           GOTOXY(X,Y);
                        END
                     ELSE
                        BEGIN
                           WRITE(CHR(7));
                        END;
               END;
            3:
               BEGIN
                  GOTOXY((X+3),Y);
                  IF INCHAR IN ['1'..'3','0',' '] THEN
                     BEGIN
                        HOLD[3] := INCHAR;
                        WRITE(INCHAR);
                        LOCATION := 4;
                        GOTOXY((X+4),Y);
                     END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN
                           GOTOXY((X+1),Y);
                           WRITE(' ');
                           LOCATION := 2;
                           HOLD[2] := ' ';
                           GOTOXY((X+1),Y);
                        END
                     ELSE
                        BEGIN
                           WRITE(CHR(7));
                        END;
               END;
            4:
               BEGIN
                  GOTOXY((X+4),Y);
                  IF INCHAR IN ['1'..'9','0'] THEN
                     BEGIN
                        HOLD[4] := INCHAR;
                        WRITE(INCHAR);
                        LOCATION := 5;
                        GOTOXY((X+6),Y);
                     END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN
                           GOTOXY((X+3),Y);
                           WRITE(' ');
                           LOCATION := 3;
                           HOLD[3] := ' ';
                           GOTOXY((X+3),Y);
                        END
                     ELSE
                        BEGIN
                           WRITE(CHR(7));
                        END;
               END;
            5:
               BEGIN
                  GOTOXY((X+6),Y);
                  IF INCHAR IN ['1'..'9','0'] THEN
                     BEGIN
                        HOLD[5] := INCHAR;
                        WRITE(INCHAR);
                        LOCATION := 6;
                        GOTOXY((X+7),Y);
                     END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN
                           GOTOXY((X+4),Y);
                           WRITE(' ');
                           LOCATION := 4;
                           HOLD[4] := ' ';
                           GOTOXY((X+4),Y);
                        END
                     ELSE
                        BEGIN
                           WRITE(CHR(7));
                        END;
               END;
            6:
               BEGIN
                  GOTOXY((X+7),Y);
                  IF INCHAR IN ['1'..'9','0'] THEN
                     BEGIN
                        HOLD[6] := INCHAR;
                        WRITE(INCHAR);
                        LOCATION := 7;
                     END
                  ELSE
                     IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
                        BEGIN
                           GOTOXY((X+6),Y);
                           WRITE(' ');
                           LOCATION := 5;
                           HOLD[5] := ' ';
                           GOTOXY((X+6),Y);
                        END
                     ELSE
                        BEGIN
                           WRITE(CHR(7));
                        END;
               END;
            7:
               BEGIN
                  IF ((INCHAR=CHR(11)) OR (INCHAR=CHR(13))) THEN
                     LOCATION := 8
                  ELSE
                     IF ((INCHAR=CHR(8)) OR (INCHAR=CHR(7))) THEN
                        BEGIN
                           GOTOXY((X+7),Y);
                           WRITE(' ');
                           LOCATION := 6;
                           HOLD[6] := ' ';
                           GOTOXY((X+7),Y);
                        END;
               END;
         END;
      END;
   READDATE := HOLD[1]+HOLD[2]+'/'+HOLD[3]+HOLD[4]+'/'+HOLD[5]+HOLD[6];
   TEXTCOLOR(LIGHTGRAY);
   TEXTBACKGROUND(BLACK);
END;

{.R+}
{.L+}